home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / HAMDEX.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-03-10  |  6.1 KB  |  265 lines
  1. 10  'HAMDEX - 18 FEB 94 rev. 22 FEB 97
  2. 20  EX$="hamdex"
  3. 30  COMMON EX$
  4. 40  CLS:KEY OFF
  5. 50  ON ERROR GOTO 330
  6. 60  COLOR 7,0,1
  7. 70  DIM A$(512,4),F$(50,4)
  8. 80  MN$="HAMCALC INDEX"                'Parent Index name
  9. 90  M$="HAMDEX"                        'this program name
  10. 100  N$="\data\index\"+M$+".fil"        'data filename
  11. 110  UL$=STRING$(80,205)
  12. 120  '
  13. 130  '.....load file
  14. 140  OPEN "I",1,N$
  15. 150  N=0
  16. 160  IF EOF(1)THEN 200
  17. 170  N=N+1:FOR Y=1 TO 4
  18. 180  INPUT# 1,A$(N,Y):NEXT Y
  19. 190  GOTO 160
  20. 200  CLOSE
  21. 210  '
  22. 220  '.....start
  23. 230  CLS
  24. 240  COLOR 15,2:PRINT STRING$(80,32);
  25. 250  LOCATE CSRLIN-1,23:PRINT "A L P H A B E T I C A L   I N D E X"
  26. 260  COLOR 1,0:PRINT STRING$(80,223);
  27. 270  COLOR 7,0
  28. 280  LOCATE 15,36
  29. 290  GOSUB 2430  'preface
  30. 300  GOSUB 2170  'start a page
  31. 310  GOTO 940
  32. 320  '
  33. 330  BEEP:CLS
  34. 340  PRINT "Error";ERR;"in line";ERL:END
  35. 350  '
  36. 360  '.....main menu
  37. 370  CLS
  38. 380  PRINT MN$
  39. 390  PRINT UL$;
  40. 400  PRINT "Press letter in ( ) to:"
  41. 410  PRINT UL$;
  42. 420  PRINT "  (a) ADD a listing to the Index"
  43. 430  PRINT "  (b) LOOK UP an Index listing"
  44. 440  PRINT "  (c) DISPLAY/PRINT Index"
  45. 450  PRINT "  (d) Return to Main Menu"
  46. 460  Z$=INKEY$
  47. 470  IF Z$="a"THEN CLS:GOTO 880
  48. 480  IF Z$="b"THEN CLS:GOTO 1200
  49. 490  IF Z$="c"THEN CLS:GOTO 940
  50. 500  IF Z$="d"THEN CLS:CHAIN EX$
  51. 510  GOTO 460
  52. 520  '
  53. 530  '.....save data
  54. 540  CLS
  55. 550  LOCATE 12,22:PRINT ".......... S O R T I N G .........."
  56. 560  OPEN "O",1,"\data\index\TEMPORY.fil"
  57. 570  FOR Z=1 TO N
  58. 580  WRITE# 1,A$(Z,1),A$(Z,2),A$(Z,3),A$(Z,4)
  59. 590  NEXT Z
  60. 600  CLOSE
  61. 610  SF$="sort < \data\index\TEMPORY.fil"+" > "+N$
  62. 620  SHELL SF$
  63. 630  KILL"\data\index\TEMPORY.fil"
  64. 640  CLS:GOTO 130
  65. 650  '
  66. 660  '.....convert to upper case
  67. 670  FOR U=1 TO LEN(I$):V=ASC(MID$(I$,U,1)):IF V=44 THEN RETURN
  68. 680  IF V>96 AND V<123 THEN MID$(I$,U,1)=CHR$(V-32)
  69. 690  NEXT U:RETURN
  70. 700  '
  71. 710  '.....inputs
  72. 720  LINE INPUT "ENTER Word or Heading..............? ";I$:GOSUB 660
  73. 730  RETURN
  74. 740  '
  75. 750  LINE INPUT "ENTER Subheading...................? ";I$
  76. 760  IF I$=""THEN 780
  77. 770  I$=", "+I$
  78. 780  RETURN
  79. 790  '
  80. 800  LINE INPUT "ENTER Supplementary note, if any...? ";I$
  81. 810  IF I$=""THEN 830
  82. 820  I$=", "+I$
  83. 830  RETURN
  84. 840  '
  85. 850  LINE INPUT "ENTER Program Filename............ ? ";I$:GOSUB 660
  86. 860  RETURN
  87. 870  '
  88. 880  '.....new listing
  89. 890  N=N+1
  90. 900  PRINT "NEW LISTING":PRINT
  91. 910  FOR Z=1 TO 4:ON Z GOSUB 720,750,800,850:A$(N,Z)=I$
  92. 920  NEXT Z:CLS:Z=N:GOTO 1730
  93. 930  '
  94. 940  '.....screen display
  95. 950  CLS
  96. 960  IF Z<>0 THEN A=Z+1 ELSE A=1
  97. 970  LN=0:C=0   'line number,counter
  98. 980    FOR Z=A TO N
  99. 990  LN=LN+1:C=C+1
  100. 1000    IF Z=1 THEN 1010
  101. 1010  Z$=CHR$(C+96)
  102. 1020  IF Z<1 THEN Z=1
  103. 1030  F$(C,1)=A$(Z,4)
  104. 1040  PRINT " <";Z$;">  ";
  105. 1050  COLOR 12,0:PRINT A$(Z,1);
  106. 1060  COLOR 7,0:PRINT A$(Z,2);A$(Z,3);
  107. 1070  IF LN<24 THEN PRINT "":GOTO 1100
  108. 1080  GOSUB 1970     'command line
  109. 1090  CLS:LN=0:C=0   'clear screen
  110. 1100    NEXT Z
  111. 1110  GOSUB 1970     'command line
  112. 1120  GOTO 940
  113. 1130  '
  114. 1140  '.....return to menu
  115. 1150  BEEP:PRINT:PRINT "There is nothing starting with ";I$;" on file......"
  116. 1160  PRINT:PRINT "Press SPACE BAR to return to Menu
  117. 1170  Z$=INKEY$:IF Z$=" "THEN CLS:GOTO 400
  118. 1180  GOTO 1170
  119. 1190  '
  120. 1200  '.....search
  121. 1210  INPUT "ENTER first 1 or 2 letters of word";I$:GOSUB 660
  122. 1220  L=LEN(I$):F=0
  123. 1230  FOR Z=1 TO N
  124. 1240   IF LEFT$(A$(Z,1),L)<>I$ THEN 1270
  125. 1250   F=F+1:F$(F,1)=A$(Z,1)+A$(Z,2)+A$(Z,3):F$(F,2)=STR$(Z):F$(F,3)=A$(Z,4)
  126. 1260  F$(F,4)=STR$(Z)
  127. 1270  NEXT Z
  128. 1280  IF F=0 THEN 1140
  129. 1290  CLS':IF F<=22 THEN 1170
  130. 1300  IF F=1 THEN Z=VAL(F$(F,2)):GOTO 1480
  131. 1310  ROW=0     'screen row number
  132. 1320  FOR Z=1 TO F
  133. 1330  ROW=ROW+1
  134. 1340   IF ROW<25 THEN 1390
  135. 1350   COLOR 0,7
  136. 1360   LOCATE 25,20:PRINT "......press any key for more......";
  137. 1370   COLOR 7,0
  138. 1380   IF INKEY$=""THEN 1380 ELSE ROW=0:CLS
  139. 1390  IF Z<10 THEN PRINT " ";
  140. 1400  PRINT Z;"   ";F$(Z,1);
  141. 1410  IF ROW<24 THEN PRINT ""
  142. 1420  NEXT Z
  143. 1430  COLOR 0,7
  144. 1440  INPUT " ENTER item no. to select listing ";J
  145. 1450  COLOR 7,0
  146. 1460  Z=VAL(F$(J,4))
  147. 1470  CLS
  148. 1480  PRINT "You have just looked up ";:COLOR 0,7
  149. 1490  PRINT " ";:FOR Q=1 TO 3:PRINT A$(Z,Q);:NEXT Q:PRINT " "
  150. 1500  COLOR 7,0
  151. 1510  PRINT UL$;
  152. 1520  PRINT "Press number in ( ) to:"
  153. 1530  PRINT UL$;
  154. 1540  PRINT "(1) RUN program pertaining to this listing"
  155. 1550  PRINT "(2) EDIT Listing"
  156. 1560  PRINT "(3) DELETE Listing"
  157. 1570  PRINT "(4) Return to menu"
  158. 1580  Z$=INKEY$
  159. 1590  IF Z$="1"THEN CLS:X$=A$(Z,4):CHAIN X$
  160. 1600  IF Z$="2"THEN CLS:GOTO 1740
  161. 1610  IF Z$="3"THEN 1860
  162. 1620  IF Z$="4"THEN CLS:GOTO 400
  163. 1630  GOTO 1580
  164. 1640  '
  165. 1650  PRINT UL$;
  166. 1660  PRINT "Line 1: Main Heading..........";A$(Z,1)
  167. 1670  PRINT "Line 2: Sub-Heading...........";A$(Z,2)
  168. 1680  PRINT "Line 3: Supplementary note....";A$(Z,3)
  169. 1690  PRINT "Line 4: Program filename......";A$(Z,4)
  170. 1700  PRINT UL$;
  171. 1710  RETURN
  172. 1720  '
  173. 1730  '.....edit listing
  174. 1740  FOR Q=1 TO 3:PRINT A$(Z,Q);:NEXT Q:PRINT ""
  175. 1750  GOSUB 1650:PRINT "Press number in ( ) for next step:"
  176. 1760  PRINT UL$;
  177. 1770  FOR Y=1 TO 4:PRINT "(";Y;")  Change Line";Y:NEXT Y
  178. 1780  PRINT "( 5 )  O.K. as is":PRINT
  179. 1790  Z$=INKEY$:Q=VAL(Z$):IF Q<1 OR Q>5 THEN 1850
  180. 1800  IF Z$="1"THEN GOSUB 720:A$(Z,1)=I$:CLS:GOSUB 1740
  181. 1810  IF Z$="2"THEN GOSUB 750:A$(Z,2)=I$:CLS:GOSUB 1740
  182. 1820  IF Z$="3"THEN GOSUB 800:A$(Z,3)=I$:CLS:GOSUB 1740
  183. 1830  IF Z$="4"THEN GOSUB 850:A$(Z,4)=I$:CLS:GOSUB 1740
  184. 1840  IF Z$="5"THEN CLS:GOTO 530                           'sort and save
  185. 1850  GOTO 1790
  186. 1860  '
  187. 1870  '.....delete listing
  188. 1880  PRINT:PRINT "Are you sure you want this listing deleted ?  (y/n)
  189. 1890  Z$=INKEY$
  190. 1900  IF Z$="n"THEN CLS:GOTO 1520
  191. 1910  IF Z$="y"THEN 1930
  192. 1920  GOTO 1890
  193. 1930  FOR X=Z TO N:LOCATE 1,40:PRINT N-X:FOR Y=1 TO 4
  194. 1940  A$(X,Y)=A$(X+1,Y):NEXT Y:NEXT X:N=N-1
  195. 1950  GOTO 530     'sort & save
  196. 1960  '
  197. 1970  '.....command line 25
  198. 1980  LOCATE 25,1:COLOR 15,1
  199. 1990  PRINT " < > RUN PROGRAM    1-NEXT PAGE    2-PREVIOUS PAGE    ";
  200. 2000  PRINT "3-ANOTHER PAGE     4-EXIT ";
  201. 2010  COLOR 7,0
  202. 2020    Z$=INKEY$:IF Z$="" THEN 2020
  203. 2030  IF Z$="0"THEN 360
  204. 2040  IF (Z$="1") AND Z>=N THEN Z=0:GOTO 2150
  205. 2050  IF Z$="1" THEN 2150
  206. 2060  IF Z$="2" THEN Z=Z-48:GOTO 2150
  207. 2070  IF Z$="3" THEN CLS:GOTO 2170
  208. 2080  IF Z$="4"THEN CLS:RUN"\bas\menu\hcal"
  209. 2090  R=ASC(Z$)-96
  210. 2100  IF R+96<97 OR R>C THEN BEEP:GOTO 1970
  211. 2110  R$=F$(R,1)
  212. 2120  IF R$=M$ THEN ERASE A$,F$:GOTO 10
  213. 2130  CLS:CHAIN R$
  214. 2140    GOTO 2020
  215. 2150  RETURN
  216. 2160  '
  217. 2170  '.....find
  218. 2180  LOCATE 4,7:COLOR 14,4
  219. 2190  PRINT " PRESS A LETTER OR NUMBER AT WHICH YOU WANT";
  220. 2200  PRINT " AN INDEX PAGE TO BEGIN. "
  221. 2210  PRINT
  222. 2220  COLOR 7,0
  223. 2230  LOCATE ,37:PRINT " - or - "
  224. 2240  PRINT:COLOR 0,7
  225. 2250  LOCATE ,25:PRINT " Press 0 to return to main menu "
  226. 2260  COLOR 7,0
  227. 2270  PRINT
  228. 2280  PRINT UL$;
  229. 2290  I$=INKEY$:IF I$=""THEN 2290
  230. 2300  IF I$="0"THEN CLS:RUN"\bas\menu\hcal"
  231. 2310  IF ASC(I$)>=97 AND ASC(I$)<=122 THEN I$=CHR$(ASC(I$)-32)
  232. 2320  CLS
  233. 2330  FOR Y=1 TO N
  234. 2340  IF LEFT$(A$(Y,1),1)=I$ THEN Z=Y-1:RETURN
  235. 2350  NEXT Y
  236. 2360  CLS:LOCATE 20,18
  237. 2370  PRINT "There is nothing in the Index starting with ";
  238. 2380  COLOR 0,7:PRINT " ";I$;" ";:COLOR 7,0:PRINT"."
  239. 2390  LOCATE 22,18:PRINT "Press any key.........."
  240. 2400  IF INKEY$=""THEN 2400
  241. 2410  CLEAR:CLS:GOTO 10
  242. 2420  '
  243. 2430  '.....preface
  244. 2440  S=7:T=9
  245. 2450  PRINT TAB(S+1);
  246. 2460  PRINT "Each page has a prompt line to select one of the following options:"
  247. 2470  PRINT TAB(S);
  248. 2480  PRINT STRING$(68,196)
  249. 2490  PRINT TAB(T+7);"Prompt                         Option"
  250. 2500  PRINT TAB(S);
  251. 2510  PRINT STRING$(68,196)
  252. 2520  T=12
  253. 2530  PRINT TAB(T);
  254. 2540  PRINT "< > RUN PROGRAM       Press any letter in < > to RUN a PROGRAM"
  255. 2550  PRINT TAB(T);
  256. 2560  PRINT "  1-NEXT PAGE         Press 1 to display NEXT index page"
  257. 2570  PRINT TAB(T);
  258. 2580  PRINT "  2-PRECEDING PAGE    Press 2 to display PRECEDING index page"
  259. 2590  PRINT TAB(T);
  260. 2600  PRINT "  3-ANOTHER PAGE      Press 3 to display ANOTHER index page"
  261. 2610  PRINT TAB(T);
  262. 2620  PRINT "  4-EXIT              Press 4 to EXIT";
  263. 2630  '
  264. 2640  RETURN
  265.